home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-11
/
advcpf.zip
/
EX.F
< prev
next >
Wrap
Text File
|
1993-01-04
|
13KB
|
419 lines
C**************************************************************************
C>>NUMBER-CRUNSHER CLIPPER> > > > > >>OR<< < < < <RENASCENCE FOR FORTRAN<<*
C**************************************************************************
C Advanced Interface: Clipper(Su'87) & Microsoft Fortran 4.x *
C (See Ed Bell's Interface to Ratfor in NanNews 9/10 '88.) *
C-------------------------------------------------------------------------*
C (c) Jobst Hensiek, January 1989 *
C Claustorwall 23 / D - 3380 Goslar 1 / WEST Germany / 011-495-321-4457 *
C CLIPPER(tm) of NANTUCKET CORP. *
C MS FORTRAN 4.1 (tm) of MICROSOFT CORP. *
C**************************************************************************
C
C What you need:
C 1. Clipper Su '87
C 2. MS-Fortran 4.x (...)
C (Install LLIBFORA to !!NO!! C-compatability, otherwise you
C will have to link LLIBCA as well!!)
C 3. File EXTOR.OBJ (Included in R. McConnell's C-Goodies, PD)
C (I put it in this ARC)
C
C What you should keep in mind:
C 1.) Include this file 'EX.F' at the top of your FORTRAN application
C ==> $INCLUDE:'EX.F'
C 2.) Declare the FORTRAN-SUB in your Clipper-file as EXTERNAL.
C 3.) Your Fortran application should be a SUBROUTINE.
C 4.) SET FL=/c /AL /FPa /Olt /Gs /Zl <FILE.FOR> ; Compiler switches
C 5.) PLINK86 FI <CLIPPER.OBJ>,<FORTRAN.OBJ>,<EXTOR.OBJ>
C SEARCH CLIPPER,LLIBFORA
C 6.) Use $LARGE, or set the '/Gtxxxx'(CAREFULL) - Compiler Switch.
C ($LARGE IS SAFE!)
C
C If you have new idea's:
C 1.) Post a msg to :76656,1606 (CompuServe)
C But DON'T waste your money on the phone.
C **** I live at least six hour's ahead of you (EASTERN TIME+6)!
C
$LARGE
C Pass String to Fortran
C CLIPPER: x=CLPFOR("STRING")
C FORTRAN: CHARACTER*N A,PARC * N String-Length, declare PARC and A
C A=PARC(ORDER [,INDEX)
INTERFACE TO CHARACTER*(*) FUNCTION PARC
+ [C, VARYING, ALIAS:'__parc'] (N)
INTEGER*2 N
END
C Pass reserved String-LENGTH to Fortran
C CLIPPER: X=SPACE(40)
C X="STRING"
C Y=CLPFOR(@X)
C FORTRAN: INTEGER*2 N,PARCSZ * N String-Length, declare PARCSZ, N
C N=PARCSZ(ORDER [,INDEX)
INTERFACE TO INTEGER*2 FUNCTION PARCSZ
+ [C, VARYING, ALIAS:'__parcsiz'] (N)
INTEGER*2 N
END
C Pass String-LENGTH to Fortran
C CLIPPER: X="STRING"
C Y=CLPFOR(X)
C FORTRAN: INTEGER*2 N,PARCLN * N String-Length, declare PARCLN, N
C N=PARCLN(ORDER [,INDEX)
INTERFACE TO INTEGER*2 FUNCTION PARCLN
+ [C, VARYING, ALIAS:'__parclen'] (N)
INTEGER*2 N
END
C Pass INTEGER to Fortran
C CLIPPER: X=69
C Y=CLPFOR(X)
C FORTRAN: INTEGER*2 N,PARNI * declare PARNI and N
C N=PARNI(ORDER [,INDEX)
INTERFACE TO INTEGER*2 FUNCTION PARNI
+ [C, VARYING, ALIAS:'__parni'] (N)
INTEGER*2 N
END
C Pass LONG-INTEGER to Fortran
C CLIPPER: X=9696969
C Y=CLPFOR(X)
C FORTRAN: INTEGER*4 N,PARNL * declare PARNL and N
C N=PARNI(ORDER [,INDEX)
INTERFACE TO INTEGER*4 FUNCTION PARNL
+ [C, VARYING, ALIAS:'__parnl'] (N)
INTEGER*2 N
END
C Pass DOUBLE to Fortran
C CLIPPER: X=96,96969
C Y=CLPFOR(X)
C FORTRAN: REAL*8 X,PARND * declare PARND and X
C X=PARND(ORDER [,INDEX)
INTERFACE TO REAL*8 FUNCTION PARND
+ [C, VARYING, ALIAS:'__parnd'] (N)
INTEGER*2 N
END
C Pass LOGICAL to Fortran
C CLIPPER: X=.T.
C Y=CLPFOR(X)
C FORTRAN: INTEGER*2 N,PARL * declare PARL, N, L and INLOG
C LOGICAL*2 INLOG,L *
C L=INLOG(PARL(ORDER [,INDEX))
INTERFACE TO INTEGER*2 FUNCTION PARL
+ [C, VARYING, ALIAS:'__parl'] (N)
INTEGER*2 N
END
C Pass DATE-STRING to Fortran
C CLIPPER: X=CTOD("09\06\96")
C Y=CLPFOR(X)
C FORTRAN: CHARACTER*8 A,PARDS * declare PARDS and A
C N=PARDS(ORDER [,INDEX)
INTERFACE TO CHARACTER*8 FUNCTION PARDS
+ [C, VARYING, ALIAS:'__pards'] (N)
INTEGER*2 N
END
C Get STRING-LENGTH in Fortran
C FORTRAN: CHARACTER*20 A * declare A,N
C INTEGER*2 N
C a='STRING'\\CHAR(0)
C N=STRLEN(A)
INTERFACE TO INTEGER*2 FUNCTION STRLEN
+ [C,ALIAS:'_strlen'] (STR)
CHARACTER*(*) STR [REFERENCE]
END
C--------------------------------------------------------------------
C CLIPPER -<FUNCTION>- RETURN VALUES
C All data-types have to declared! (You know what I mean!?)
C
C !DON't RETURN MORE THAN ONE VALUE OR STRING, OR KILL THE STACK!
C
C Push STRING to CLIPPER
C FORTRAN: A='Hello Ed'
C CALL RETC(A)
C CLIPPER: Y=CLPFOR(X)
C Y -< Hello Ed
INTERFACE TO SUBROUTINE RETC
+ [C, ALIAS:'__retc'] (STR)
CHARACTER*(*) STR [REFERENCE]
END
C Push STRING to CLIPPER
C FORTRAN: A='Hello Ed'
C CALL RCLEN('A')
C CLIPPER: Y=CLPFOR(X)
C Y -< 8
INTERFACE TO SUBROUTINE RCLEN
+ [C, ALIAS:'__retclen'] (STR,N)
CHARACTER*(*) STR [REFERENCE]
INTEGER*2 N
END
C Push INTEGER to CLIPPER
C FORTRAN: N=69
C CALL RETNI(N)
C CLIPPER: Y=CLPFOR(X)
C Y -< 69
INTERFACE TO SUBROUTINE RETNI
+ [C, ALIAS:'__retni'] (N)
INTEGER*2 N
END
C Push LONG-INTEGER to CLIPPER
C FORTRAN: N=6969696969
C CALL RETNL(N)
C CLIPPER: Y=CLPFOR(X)
C Y -< 6969696969
INTERFACE TO SUBROUTINE RETNL
+ [C, ALIAS:'__retnl'] (N)
INTEGER*4 N
END
C Push DOUBLE to CLIPPER
C FORTRAN: X=69,69696969
C CALL RETND(N)
C CLIPPER: Y=CLPFOR(X)
C Y -< 69,69696969
INTERFACE TO SUBROUTINE RETND
+ [C, ALIAS:'__retnd'] (N)
REAL*8 N
END
C Push LOGICAL to CLIPPER
C FORTRAN: L=.TRUE.
C CALL RETL(LOGIN(L))
C CLIPPER: Y=CLPFOR(X)
C Y -<.T.
INTERFACE TO SUBROUTINE RETL
+ [C, ALIAS:'__retl'] (N)
INTEGER*2 N
END
C Push DATE-STRING to CLIPPER
C FORTRAN: A='19690606'
C CALL RETDS(A)
C CLIPPER: Y=CLPFOR(X)
C Y < 06\06\69
INTERFACE TO SUBROUTINE RETDS
+ [C, ALIAS:'__retds'] (DSTR)
CHARACTER*8 DSTR [REFERENCE]
END
C It cleans up the stack, i guess (?)
INTERFACE TO SUBROUTINE RET
+ [C, ALIAS:'__ret']
END
C ALLOCATE MEMORY.
C PARAMETER: REQUESTED SIZE IN BYTES.
C RETURNS FAR POINTER TO MEMORY OR NULL.
INTERFACE TO INTEGER*4 FUNCTION XMGRAB
+ [C, ALIAS:'__exmgrab'] (N)
INTEGER*2 N
END
INTERFACE TO SUBROUTINE XMBACK
+ [C, ALIAS:'__exmback'] (I, J)
INTEGER*4 I [REFERENCE]
INTEGER*2 J
END
C ----------------------------------------------------------------------
C Be sure, ALL PARAMETERS passed by REFERENCE from Clipper: <'@X'> !
C McConnell's EXTOR-SYSTEM is very usefull for doing MATH with Clipper!
C - This is my personal opinion.
C
C !FEEL FREE TO RETURN MORE THAN ONE VALUE OR STRING, THE STACK LIKES IT!
C
C Push DOUBLE back to CLIPPER
C FORTRAN: CALL STRND(VALUE, ORDER [,INDEX)
INTERFACE TO SUBROUTINE STRND
+ [C, VARYING, ALIAS:'__stornd'] (X,N)
REAL*8 X
INTEGER*2 N
END
C Push DOUBLE with DECIMAL's back to CLIPPER
C FORTRAN: CALL STRNDC(VALUE, DECIMAL, ORDER [,INDEX)
INTERFACE TO SUBROUTINE STRNDC
+ [C, VARYING, ALIAS:'__storndec'] (X,K,N)
REAL*8 X
INTEGER*2 K,N
END
C Push LONG-INTEGER back to CLIPPER
C FORTRAN: CALL STRNL(VALUE, ORDER [,INDEX)
INTERFACE TO SUBROUTINE STRNL
+ [C, VARYING, ALIAS:'__stornl'] (K,N)
INTEGER*4 K
INTEGER*2 N
END
C Push INTEGER back to CLIPPER
C FORTRAN: CALL STRNI(VALUE, ORDER [,INDEX)
INTERFACE TO SUBROUTINE STRNI
+ [C, VARYING, ALIAS:'__storni'] (K,N)
INTEGER*2 K,N
END
C Push STRING back to CLIPPER
C FORTRAN: CALL STRC('STRING', ORDER [,INDEX)
INTERFACE TO SUBROUTINE STRC
+ [C, VARYING, ALIAS:'__storc'] (STR,N)
CHARACTER*(*) STR [REFERENCE]
INTEGER*2 N
END
C Push LOGICAL back to Clipper
C FORTRAN: CALL STRL(FLAG , ORDER [,INDEX)
INTERFACE TO SUBROUTINE STRL
+ [C, VARYING, ALIAS:'__storl'] (K,N)
INTEGER*2 K,N
END
C Push STRING-LEN back to CLIPPER
C FORTRAN: A='STRING'//CHAR(0)
C CALL STRCLN(A, ORDER [,INDEX)
INTERFACE TO SUBROUTINE STRCLN
+ [C, VARYING, ALIAS:'__storclen'] (STR,K,N)
CHARACTER*(*) STR [REFERENCE]
INTEGER*2 K,N
END
C Push DATE-STRING back to CLIPPER
C FORTRAN: CALL STRDS('DATE-STRING', ORDER [,INDEX)
INTERFACE TO SUBROUTINE STRDS
+ [C,VARYING,ALIAS:'__stords'] (DSTR,N)
CHARACTER*8 DSTR [REFERENCE]
INTEGER*2 N
END
C Convert LOGICAL to INTEGER
C FORTRAN: CALL STORL(LOGIN(FLAG)) and pass it to Clipper
INTEGER*2 FUNCTION LOGIN(L)
LOGICAL*2 L [VALUE]
LOGIN=0
IF(L)LOGIN=1
RETURN
END
C-------------------------------------------------------------------------
C A FUNCTION !!!MUST!!!ALWAYS!!! BE DECLARED IN THE CALLING SUBROUTINE!
C EXAMPLE: INTEGER*2 ALNGTH,N
C N=ALNGTH(ORDER)
C
C Get Parameter Info. (Used in functions below)
INTERFACE TO INTEGER*2 FUNCTION PINFO
+ [C, ALIAS:'__parinfo'] (N)
INTEGER*2 N
END
C Get Array-Parameter Info. (Used in functions below)
INTERFACE TO INTEGER*2 FUNCTION PINFA
+ [C, ALIAS: '__parinfa'] (K,N)
INTEGER*2 K,N
END
C Convert INTEGER to LOGICAL
C FORTRAN: X=INLOG(PARL(ORDER))
LOGICAL*2 FUNCTION INLOG(N)
INTEGER*2 N [VALUE]
INLOG=.FALSE.
IF(N.EQ.1)INLOG=.TRUE.
RETURN
END
C Number of Parameters passed
C FORTRAN: N=PCOUNT()
INTEGER*2 FUNCTION PCOUNT
INTEGER*2 PINFO
PCOUNT=PINFO(0)
RETURN
END
C Size of array (INDEX - COUNT)
C FORTRAN: N=ALNGTH(ORDER)
INTEGER*2 FUNCTION ALNGTH(N)
INTEGER*2 N [VALUE]
INTEGER*2 PINFA
ALNGTH=PINFA(N,0)
RETURN
END
C Gives .TRUE. for a CHARACTER
C FORTRAN: L=ISCHAR(ORDER)
LOGICAL*2 FUNCTION ISCHAR(N)
INTEGER*2 N [VALUE]
INTEGER*2 PINFO,INF
INF=PINFO(N)
ISCHAR=.FALSE.
IF ((INF.EQ.1).OR.(INF.EQ.33))ISCHAR=.TRUE.
RETURN
END
C Gives .TRUE. for a NUMBER
LOGICAL*2 FUNCTION ISNUM(N)
INTEGER*2 N [VALUE]
INTEGER*2 PINFO,INF
INF=PINFO(N)
ISNUM=.FALSE.
IF ((INF.EQ.2).OR.(INF.EQ.34))ISNUM=.TRUE.
RETURN
END
C Gives .TRUE. for a LOGICAL
LOGICAL*2 FUNCTION ISLOG(N)
INTEGER*2 N [VALUE]
INTEGER*2 PINFO,INF
INF=PINFO(N)
ISLOG=.FALSE.
IF ((INF.EQ.4).OR.(INF.EQ.36))ISLOG=.TRUE.
RETURN
END
C Gives .TRUE. for a DATE-STRING
LOGICAL*2 FUNCTION ISDATE(N)
INTEGER*2 N [VALUE]
INTEGER*2 PINFO,INF
INF=PINFO(N)
ISDATE=.FALSE.
IF ((INF.EQ.8).OR.(INF.EQ.40))ISDATE=.TRUE.
RETURN
END
C Ceck for Memo (?)
LOGICAL*2 FUNCTION ISMEMO(N)
INTEGER*2 N [VALUE]
INTEGER*2 PINFO,INF
INF=PINFO(N)
ISMEMO=.FALSE.
IF ((INF.EQ.65).OR.(INF.EQ.97))ISMEMO=.TRUE.
RETURN
END
C Gives .TRUE. for a ARRAY
LOGICAL*2 FUNCTION ISARRY(N)
INTEGER*2 N [VALUE]
INTEGER*2 PINFO,INF
INF=PINFO(N)
ISARRY=.FALSE.
IF ((INF.EQ.512).OR.(INF.EQ.544))ISARRY=.TRUE.
RETURN
END
C Header structure.
SUBROUTINE DBF
COMMON /DBFBLK/SIG,YMD,LREC,DATA_OFF,REC_SIZE,PAD
CHARACTER*1 SIG
CHARACTER*3 YMD
INTEGER*4 LREC
INTEGER*2 DATA_OFF
INTEGER*2 REC_SIZE
CHARACTER*20 PAD(20)
RETURN
END